home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbrdata.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-07  |  22.3 KB  |  602 lines
  1. (*===========================================================================*)
  2. (* Used to receive frames from TNC.  Will call link change if LC frame.      *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991, 1992 by H. Roy Engehausen.  All       *)
  5. (*   rights reserved.                                                        *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. UNIT BBRDATA;
  10.  
  11. INTERFACE
  12.  
  13. FUNCTION  read_tnc_data_str     : STRING;
  14. FUNCTION  read_tnc_data_pending : BOOLEAN;
  15. PROCEDURE read_flush;
  16.  
  17. IMPLEMENTATION
  18.  
  19. USES
  20.   DOS,
  21.   bbconsl,
  22.   bbdummy,
  23.   bblc,
  24.   bblstr,
  25.   bbmess,
  26.   bbmisc4,
  27.   bbmore,
  28.   bbsdata,
  29.   bbsess,
  30.   bbsrt,
  31.   bbstr,
  32.   bbtask,
  33.   bbtime,
  34.   bbtrace,
  35.   bbwin;
  36.  
  37. {$UNDEF DEBUG}
  38. {$UNDEF BOOBOO}
  39. {$UNDEF CRTIME}
  40.  
  41. TYPE data_packet_result = (data_skip,
  42.                            data_present,
  43.                            timeout_because_cr,
  44.                            timeout_because_user);
  45.  
  46. (*===========================================================================*)
  47. (* Read Data -- String format                                                *)
  48. (*===========================================================================*)
  49.  
  50. FUNCTION read_tnc_data_str : STRING;
  51.  
  52.   VAR
  53.     bs_pos             : BYTE;
  54.     cr_found           : BOOLEAN;
  55.     cr_pos             : WORD;
  56.     cr_timeout_sw      : BOOLEAN;
  57.     cr_timeout_yes     : BOOLEAN;
  58.     i_loop             : BYTE;
  59.     read_result        : data_packet_result;
  60.     timeout_value_cr   : WORD;
  61.     timeout_value_user : WORD;
  62.     result_str         : STRING;
  63.     this_i_data        : str_mixed_ptr;
  64.  
  65.   (*=========================================================================*)
  66.   (* Read Data                                                               *)
  67.   (*=========================================================================*)
  68.  
  69.   FUNCTION read_tnc_data_packet : data_packet_result;
  70.  
  71.     VAR
  72.       timer_on         : BOOLEAN;
  73.       timeout_for_cr   : LONGINT;
  74.       timeout_for_user : LONGINT;
  75.  
  76.     BEGIN;
  77.  
  78.       (*---------------------------------------------------------------------*)
  79.       (* Flush any data from the sending buffers                             *)
  80.       (*---------------------------------------------------------------------*)
  81.  
  82.       send_flush;
  83.  
  84.       (*---------------------------------------------------------------------*)
  85.       (* Now we will loop looking for incoming data                          *)
  86.       (*---------------------------------------------------------------------*)
  87.  
  88.       timer_on := FALSE;
  89.  
  90.       REPEAT
  91.  
  92.         (*-------------------------------------------------------------------*)
  93.         (* Switch tasks just for the heck of it                              *)
  94.         (*-------------------------------------------------------------------*)
  95.  
  96.         task_switch;
  97.  
  98.         (*-------------------------------------------------------------------*)
  99.         (* Handle time expiring                                              *)
  100.         (*-------------------------------------------------------------------*)
  101.  
  102.         IF timer_on THEN
  103.           BEGIN;
  104.  
  105.             (*---------------------------------------------------------------*)
  106.             (* Main timer                                                    *)
  107.             (*---------------------------------------------------------------*)
  108.  
  109.             IF (up_time > timeout_for_user) THEN
  110.               BEGIN;
  111.                 read_tnc_data_packet := timeout_because_user;
  112.                 EXIT;
  113.               END;
  114.  
  115.             (*---------------------------------------------------------------*)
  116.             (* CR timer                                                      *)
  117.             (*---------------------------------------------------------------*)
  118.  
  119.             IF (up_time > timeout_for_cr) THEN
  120.               BEGIN;
  121.                 read_tnc_data_packet := timeout_because_cr;
  122.                 EXIT;
  123.               END;
  124.  
  125.           END
  126.  
  127.         ELSE
  128.  
  129.           (*-----------------------------------------------------------------*)
  130.           (* See if we should start timer                                    *)
  131.           (*-----------------------------------------------------------------*)
  132.  
  133.           IF send_unacked(TRUE) = 0 THEN
  134.             BEGIN;
  135.               timer_on         := TRUE;
  136.               timeout_for_user := up_time_from_now(timeout_value_user);
  137.               timeout_for_cr   := up_time_from_now(timeout_value_cr);
  138.             END;
  139.  
  140.         (*-------------------------------------------------------------------*)
  141.         (* Poll for incoming data                                            *)
  142.         (*-------------------------------------------------------------------*)
  143.  
  144.         send_recv_tnc(2);
  145.  
  146.       UNTIL NOT active_tcb^.tnc_null; (*--- End loop wait for incoming data  *)
  147.  
  148.       timer_on := FALSE;
  149.  
  150.       (*---------------------------------------------------------------------*)
  151.       (* Handle link status change                                           *)
  152.       (*---------------------------------------------------------------------*)
  153.  
  154.       IF active_tcb^.tnc_type = t_to_h_links THEN
  155.         BEGIN;
  156.  
  157.           IF ((active_port^.port_type = port_modem)
  158.                                  OR (active_port^.port_type = port_null_modem))
  159.                          AND active_port^.modem_dial THEN
  160.             BEGIN;
  161.               active_port^.modem_conn := TRUE;
  162.               read_tnc_data_packet    := data_present;
  163.             END
  164.           ELSE
  165.             BEGIN;
  166.               link_change;
  167.               read_tnc_data_packet := data_skip;
  168.             END;
  169.  
  170.           task_switch;
  171.           EXIT;
  172.  
  173.         END;
  174.  
  175.       (*---------------------------------------------------------------------*)
  176.       (* Watch out for other things                                          *)
  177.       (*---------------------------------------------------------------------*)
  178.  
  179.       WITH active_tcb^ DO
  180.         IF (tnc_type <> t_to_h_conn) AND (channel <> 0) THEN
  181.           BEGIN;
  182.             WRITELN('RDATA');
  183.             WRITELN('Improper response to G command on ', port_chan_s);
  184.             WRITELN('Type was ', tnc_type);
  185.             WRITELN('Ans was ', tnc_data.str_data);
  186.           END;
  187.  
  188.       read_tnc_data_packet := data_present;
  189.  
  190.     END;
  191.  
  192.   (*=========================================================================*)
  193.   (* Main line of read_data_string                                           *)
  194.   (*=========================================================================*)
  195.  
  196.   BEGIN;
  197.  
  198.     (*-----------------------------------------------------------------------*)
  199.     (* Get local pointer                                                     *)
  200.     (*-----------------------------------------------------------------------*)
  201.  
  202.     this_i_data := @active_tcb^.i_data;
  203.  
  204.     (*-----------------------------------------------------------------------*)
  205.     (* Clear the more information                                            *)
  206.     (*-----------------------------------------------------------------------*)
  207.  
  208.     more_clear;
  209.  
  210.     (*-----------------------------------------------------------------------*)
  211.     (* Console is special                                                    *)
  212.     (*-----------------------------------------------------------------------*)
  213.  
  214.     IF active_tcb^.tcb_console THEN
  215.       BEGIN;
  216.         send_flush;
  217.         operator_line;
  218.         read_tnc_data_str        := this_i_data^.str_data;
  219.         window_write(active_tcb^.port_chan_s + '<:', this_i_data^.str_data);
  220.         this_i_data^.str_data    := '';
  221.         this_i_data^.long_length := 0;
  222.         EXIT;
  223.       END;
  224.  
  225.     (*-----------------------------------------------------------------------*)
  226.     (* Initialize                                                            *)
  227.     (*-----------------------------------------------------------------------*)
  228.  
  229.     active_tcb^.tnc_data.long_length := 0;
  230.     active_tcb^.tnc_data.str_data    := '';
  231.  
  232.     timeout_value_user := active_port^.time_out;
  233.  
  234.     (*-----------------------------------------------------------------------*)
  235.     (* See if we must have a timeout for a terminal mode thing               *)
  236.     (*-----------------------------------------------------------------------*)
  237.  
  238.     cr_timeout_sw := ((active_port^.port_type = port_modem)
  239.                                  OR (active_port^.port_type = port_null_modem))
  240.                            AND (active_port^.cr_timeout <> 0);
  241.  
  242.     IF cr_timeout_sw THEN
  243.       timeout_value_cr := active_port^.cr_timeout
  244.     ELSE
  245.       timeout_value_cr := timeout_value_user + 1;
  246.  
  247.     {$IFDEF CRTIME}
  248.        trace_data('RDA1', ORD(cr_timeout_sw), NIL, '');
  249.        trace_data('RDA2', timeout_value_cr, NIL, '');
  250.     {$ENDIF}
  251.  
  252.     (*-----------------------------------------------------------------------*)
  253.     (* See if we found a CR yet                                              *)
  254.     (*-----------------------------------------------------------------------*)
  255.  
  256.     cr_pos := l_pos(this_i_data, cr);
  257.  
  258.     {$IFDEF DEBUG}
  259.       WITH active_tcb^ DO BEGIN;
  260.       WRITELN('Start loop');
  261.       WRITELN('Cr_pos = ', cr_pos);
  262.       WRITELN('tnc_data =', tnc_data.long_length,  '=', tnc_data.str_data);
  263.       WRITELN('this_data =', this_i_data^.long_length,
  264.                                                    '=', this_i_data^.str_data);
  265.       END;
  266.     {$ENDIF}
  267.  
  268.     {$IFDEF CRTIME}
  269.        trace_data('RDA3', cr_pos, NIL, this_i_data^.str_data);
  270.     {$ENDIF}
  271.  
  272.     (*-----------------------------------------------------------------------*)
  273.     (* If line too long for string then shorten it                           *)
  274.     (*-----------------------------------------------------------------------*)
  275.  
  276.     IF cr_pos > 255 THEN
  277.       cr_pos := 255;
  278.  
  279.     (*-----------------------------------------------------------------------*)
  280.     (* If no CR then we wait for one                                         *)
  281.     (*-----------------------------------------------------------------------*)
  282.  
  283.     IF cr_pos = 0 THEN
  284.       BEGIN;
  285.  
  286.         (*-------------------------------------------------------------------*)
  287.         (* Flush the output buffer                                           *)
  288.         (*-------------------------------------------------------------------*)
  289.  
  290.         send_flush;
  291.  
  292.         (*-------------------------------------------------------------------*)
  293.         (* Loop for CR                                                       *)
  294.         (*-------------------------------------------------------------------*)
  295.  
  296.         WITH active_tcb^ DO
  297.           REPEAT
  298.  
  299.             {$IFDEF DEBUG}
  300.               WRITELN('Before read');
  301.               WRITELN('Cr_pos = ', cr_pos);
  302.               WRITELN('tnc_data =', tnc_data.long_length,
  303.                                                    '=',  tnc_data.str_data);
  304.               WRITELN('this_data =', this_i_data^.long_length,
  305.                                                    '=', this_i_data^.str_data);
  306.             {$ENDIF}
  307.  
  308.             (*---------------------------------------------------------------*)
  309.             (* Wait here for a packet                                        *)
  310.             (*---------------------------------------------------------------*)
  311.  
  312.             REPEAT
  313.               read_result := read_tnc_data_packet;
  314.  
  315.               IF read_result = data_skip THEN
  316.                 FOR i_loop := 1 TO 20 DO
  317.                   task_switch;
  318.             UNTIL read_result <> data_skip;
  319.  
  320.             (*---------------------------------------------------------------*)
  321.             (* Kill user session on timeout                                  *)
  322.             (*---------------------------------------------------------------*)
  323.  
  324.             IF read_result = timeout_because_user THEN
  325.               BEGIN;
  326.                 IF tcb_never_kill THEN
  327.                   read_result := timeout_because_cr
  328.                 ELSE
  329.                   timer_end_session;
  330.               END;
  331.  
  332.             (*---------------------------------------------------------------*)
  333.             (* See if we had a carriage return timeout                       *)
  334.             (*---------------------------------------------------------------*)
  335.  
  336.             cr_timeout_yes := read_result = timeout_because_cr;
  337.  
  338.             (*---------------------------------------------------------------*)
  339.             (* Debug display                                                 *)
  340.             (*---------------------------------------------------------------*)
  341.  
  342.             {$IFDEF CRTIME}
  343.               trace_data('RDA4', tnc_data.long_length, NIL, tnc_data.str_data);
  344.             {$ENDIF}
  345.  
  346.             {$IFDEF DEBUG}
  347.               WRITELN('After read');
  348.               WRITELN('Cr_pos = ', cr_pos);
  349.               WRITELN('tnc_data =', tnc_data.long_length,
  350.                                                    '=', tnc_data.str_data);
  351.               WRITELN('this_data =', this_i_data^.long_length,
  352.                                                    '=', this_i_data^.str_data);
  353.             {$ENDIF}
  354.  
  355.             (*---------------------------------------------------------------*)
  356.             (* Put incoming data on end of buffer                            *)
  357.             (*---------------------------------------------------------------*)
  358.  
  359.             l_cat(this_i_data, @tnc_data);
  360.  
  361.             {$IFDEF DEBUG}
  362.               WRITELN('After cat ');
  363.               WRITELN('Cr_pos = ', cr_pos);
  364.               WRITELN('tnc_data =', tnc_data.long_length,
  365.                                                    '=', tnc_data.str_data);
  366.               WRITELN('this_data =', this_i_data^.long_length,
  367.                                                    '=', this_i_data^.str_data);
  368.             {$ENDIF}
  369.  
  370.             (*---------------------------------------------------------------*)
  371.             (* Any CR in sight?                                              *)
  372.             (*---------------------------------------------------------------*)
  373.  
  374.             cr_pos := l_pos(this_i_data, cr);
  375.  
  376.             {$IFDEF DEBUG}
  377.               WRITELN('After pos ');
  378.               WRITELN('Cr_pos = ', cr_pos);
  379.             {$ENDIF}
  380.  
  381.             (*---------------------------------------------------------------*)
  382.             (* Force fake end if more than one string worth                  *)
  383.             (*---------------------------------------------------------------*)
  384.  
  385.             cr_found := cr_pos <> 0;
  386.             IF cr_pos > 255 THEN
  387.               BEGIN;
  388.                 cr_pos   := 255;
  389.                 cr_found := FALSE;
  390.               END;
  391.  
  392.             (*---------------------------------------------------------------*)
  393.             (* Handle timeout for carriage return                            *)
  394.             (*---------------------------------------------------------------*)
  395.  
  396.             IF cr_timeout_yes AND (cr_pos = 0) THEN
  397.               BEGIN;
  398.                 cr_pos := this_i_data^.long_length;
  399.                 IF cr_pos = 0 THEN
  400.                   BEGIN;
  401.                     read_tnc_data_str := '';
  402.                     {$IFDEF CRTIME}
  403.                       trace_data('RDA5', 0, NIL, '');
  404.                     {$ENDIF}
  405.                     EXIT;
  406.                   END;
  407.               END;
  408.  
  409.             (*---------------------------------------------------------------*)
  410.             (* If too long then force a CR anyway                            *)
  411.             (*---------------------------------------------------------------*)
  412.  
  413.             IF NOT cr_found THEN
  414.               BEGIN;
  415.                 IF this_i_data^.long_length > 255 THEN
  416.                   cr_pos := 255
  417.                 ELSE
  418.                   IF tnc_data.long_length > 0 THEN
  419.                     cr_pos := this_i_data^.long_length;
  420.               END;
  421.  
  422.           UNTIL cr_pos <> 0; (*----- End of search for CR loop --------------*)
  423.  
  424.       END; (*----- End of code when no CR in buffer -------------------------*)
  425.  
  426.     (*-----------------------------------------------------------------------*)
  427.     (* Check for booboo                                                      *)
  428.     (*-----------------------------------------------------------------------*)
  429.  
  430.     {$IFDEF BOOBOO}
  431.       IF cr_pos > 255 THEN
  432.         WITH active_tcb^ DO
  433.           BEGIN;
  434.             WRITELN('Invalid packet size in RDATA');
  435.             WRITELN('Cr_pos = ', cr_pos);
  436.             WRITELN('tnc_data =', tnc_data.long_length,
  437.                                                    '=', tnc_data.str_data);
  438.             WRITELN('this_data =', this_i_data^.long_length,
  439.                                                    '=', this_i_data^.str_data);
  440.             HALT;
  441.           END;
  442.     {$ENDIF}
  443.  
  444.     (*-----------------------------------------------------------------------*)
  445.     (* Get result                                                            *)
  446.     (*-----------------------------------------------------------------------*)
  447.  
  448.     result_str := substr(this_i_data^.str_data, 1, cr_pos);
  449.  
  450.     (*-----------------------------------------------------------------------*)
  451.     (* Skip the CR                                                           *)
  452.     (*-----------------------------------------------------------------------*)
  453.  
  454.     INC(cr_pos);
  455.  
  456.     (*-----------------------------------------------------------------------*)
  457.     (* Check for booboo                                                      *)
  458.     (*-----------------------------------------------------------------------*)
  459.  
  460.     {$IFDEF BOOBOO}
  461.       IF i > 256 THEN
  462.         BEGIN;
  463.           WRITELN('RDATA');
  464.           WRITELN('Suspect packet break position -- ', cr_pos);
  465.           WRITELN('IDATA = ', active_tcb^.i_data.long_length);
  466.           WRITELN('TNC DATA = ', active_tcb^.tnc_data.long_length);
  467.           cr_pos := 256;
  468.         END;
  469.     {$ENDIF}
  470.  
  471.     (*-----------------------------------------------------------------------*)
  472.     (* Move up any data remaining and concatenate old data                   *)
  473.     (*-----------------------------------------------------------------------*)
  474.  
  475.     active_tcb^.i_data := l_substr(@active_tcb^.i_data, cr_pos, 0)^;
  476.     IF active_tcb^.tnc_data.long_length > 0 THEN
  477.       l_cat(@active_tcb^.i_data, @active_tcb^.tnc_data);
  478.  
  479.     (*-----------------------------------------------------------------------*)
  480.     (* Check for booboo                                                      *)
  481.     (*-----------------------------------------------------------------------*)
  482.  
  483.     {$IFDEF BOOBOO}
  484.       WITH active_tcb^ DO
  485.         IF tnc_data.long_length > 0 THEN
  486.           BEGIN;
  487.             WRITELN('Lost incoming data packet');
  488.             WRITELN('TDATA =', tnc_data.long_length, ' = ', tnc_data.str_data);
  489.             WRITELN('IDATA =', i_data.long_length,   ' = ', i_data.str_data);
  490.             WRITELN('RDATA =', LENGTH(result_str),   ' = ', result_str);
  491.           END;
  492.     {$ENDIF}
  493.  
  494.     (*-----------------------------------------------------------------------*)
  495.     (* If modem then handle backspaces                                       *)
  496.     (*-----------------------------------------------------------------------*)
  497.  
  498.     IF ((active_port^.port_type = port_modem)
  499.                                 OR (active_port^.port_type = port_null_modem))
  500.                      AND NOT active_tcb^.tcb_binary THEN
  501.      BEGIN;
  502.  
  503.        bs_pos := POS(bs, result_str);
  504.  
  505.        WHILE bs_pos <> 0 DO
  506.          BEGIN;
  507.  
  508.            i_loop := LENGTH(result_str) - bs_pos;
  509.  
  510.            IF (bs_pos <> 1) AND (i_loop > 0) THEN
  511.              BEGIN;
  512.  
  513.                MOVE(result_str[bs_pos+1], result_str[bs_pos-1], i_loop);
  514.  
  515.                DEC(BYTE(result_str[0]));
  516.  
  517.              END
  518.            ELSE
  519.              IF i_loop > 0 THEN
  520.                MOVE(result_str[bs_pos+1], result_str[bs_pos], i_loop);
  521.  
  522.            DEC(BYTE(result_str[0]));
  523.  
  524.            bs_pos := POS(bs, result_str);
  525.  
  526.          END; (*----- End loop for backspaces -------------------------------*)
  527.  
  528.      END; (*----- End backspace handler -------------------------------------*)
  529.  
  530.     (*-----------------------------------------------------------------------*)
  531.     (* Show incoming line                                                    *)
  532.     (*-----------------------------------------------------------------------*)
  533.  
  534.     window_write(active_tcb^.port_chan_s + '<:', result_str);
  535.  
  536.     (*-----------------------------------------------------------------------*)
  537.     (* Set result                                                            *)
  538.     (*-----------------------------------------------------------------------*)
  539.  
  540.     read_tnc_data_str := result_str;
  541.  
  542.   END;
  543.  
  544. (*===========================================================================*)
  545. (* Read Data Pending                                                         *)
  546. (*===========================================================================*)
  547.  
  548. FUNCTION read_tnc_data_pending : BOOLEAN;
  549.  
  550.   VAR
  551.     i: WORD;
  552.     j: WORD;
  553.  
  554.   BEGIN;
  555.  
  556.      j := active_tcb^.i_data.long_length;
  557.      IF active_tcb^.tcb_binary THEN
  558.        read_tnc_data_pending := j <> 0
  559.      ELSE
  560.        BEGIN;
  561.          i := l_pos(@active_tcb^.i_data, cr);
  562.          read_tnc_data_pending := (i <> 0) OR (j >= 255);
  563.        END;
  564.  
  565.   END;
  566.  
  567. (*===========================================================================*)
  568. (* Read Flush                                                                *)
  569. (*===========================================================================*)
  570.  
  571. PROCEDURE read_flush;
  572.   BEGIN;
  573.  
  574.     WHILE TRUE DO
  575.       WITH active_tcb^ DO
  576.         BEGIN;
  577.  
  578.           task_switch;
  579.  
  580.           send_recv_tnc(2);
  581.  
  582.           IF tnc_null THEN EXIT;
  583.  
  584.           IF tnc_type = t_to_h_links THEN
  585.             BEGIN;
  586.               link_change;
  587.               task_switch;
  588.             END
  589.           ELSE
  590.             IF (tnc_type <> t_to_h_conn) AND (channel <> 0) THEN
  591.               BEGIN;
  592.                 WRITELN('RFLUSH');
  593.                 WRITELN('Improper response to G command on ', port_chan_s);
  594.                 WRITELN('Type was ', tnc_type);
  595.                 WRITELN('Ans was ', tnc_data.str_data);
  596.               END;
  597.         END;
  598.  
  599.   END;
  600.  
  601. END.
  602.